#!/usr/bin/perl -w

# Copyright (C) 2006 Google Inc.
# Author: Manu Garg <manugarg@google.com>
#
# pactester is a tool to test proxy auto-configuration (PAC) files. Please read
# README file included with this package for more information about this tool.
#
# pactester is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.

# pactester is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.

# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA

use strict;

use FindBin;
use Getopt::Std;
use Socket;
use Sys::Hostname;

#use lib qw(INCPATH)
use JavaScript::SpiderMonkey;

my %options=();
getopt("puhcf",\%options);

my $mypac_file = $options{p} if defined $options{p};
my $url = $options{u} if defined $options{u};
my $host = $options{h} if defined $options{h};
my $client_ip = $options{c} if defined $options{c};
my $urls_list = $options{f} if defined $options{f};

sub printusage{
  print <<EOF

Usage:  ./pactester <-p pacfile> <-u url> [-h host] [-c client_ip]
        ./pactester <-p pacfile> <-f urlslist> [-c client_ip]

Options:
  -p pacfile: PAC file to test
  -u url: URL to test
  -h host: Host part of the URL
  -c client_ip: client IP address (defaults to IP address of the machine on which script is running)
  -f urlslist: a file containing list of URLs to be tested.
EOF
}

# Check for right number of options
if (not defined $mypac_file or (not defined $url and not defined $urls_list)) {
  print "Wrong number of arguments!\n";
  printusage();
  exit(1);
}

# Don't process $urls_list and $url at the same time
if (defined $urls_list and defined $url) {
  print "Wrong number of arguments!\n";
  printusage();
  exit(1);
}

# Validate IP address
if (defined $client_ip) {
  my @octets = split(/\./, $client_ip);
  if ($client_ip !~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ or
      $octets[0] > 255 or $octets[1] > 255 or
      $octets[2] > 255 or $octets[3] > 255) {
    print "Invalid IP address: $client_ip!\n";
    printusage();
    exit(1);
  }
}

# Define DNS resolve needed by pac files
sub dns_res($) {
  my $hostname = shift;
  my $addr = gethostbyname($hostname);
  if ($addr) { return inet_ntoa($addr); }
  else { return 'null'; }
}

# Define a function to get my IP address
sub my_ip() {
  if (defined $client_ip) { return $client_ip; }
  my $ip = dns_res(Sys::Hostname::hostname);
  if ($ip eq 'null') { return '127.0.0.1'; }
  return $ip;
}

# Find proxy for a url and a host
sub findproxy($$$) {
  my ($j, $url, $host) = @_;
  $j->property_by_path("pac.url",$url);
  $j->property_by_path("pac.host",$host);
  $j->property_by_path("pac.proxy");
  my $rc = $j->eval(q!
    pac.proxy=FindProxyForURL(pac.url,pac.host);
  !);
  if ($rc != 1) {print $@; return 0;}
  return 1;
}

# pac utils path. this file contains the js function used in pac files.
my $pac_utils_path .= "$FindBin::Bin/pac_utils.js";

# Read javascript files to evaluate
my $oldifs = $/;
undef $/;
open(FILE,$pac_utils_path) || die "Could not open pac_utils.js\n";
my $nspac = <FILE>;
close(FILE);
open(FILE,$mypac_file) || die "Could not open your pac file: $mypac_file\n";
my $mypac = <FILE>;
close(FILE);
$/ = $oldifs;

# Create and initialize JavaScript context
my $js_context = JavaScript::SpiderMonkey->new();
$js_context->init();  # Initialize Runtime/Context

# Export perl functions to JavaScript context.
$js_context->function_set("dnsResolve", sub {dns_res shift});
$js_context->function_set("myIpAddress", sub {my_ip});

# Evaluate pac_utils.js and PAC file
my $rc = $js_context->eval($nspac);
$rc = $js_context->eval($mypac);
if ($rc != 1) {
  print $@;
  die "Could not evaluate your pac file\n"
}

# Single URL mode
if (defined $url){
  $url =~ /.*\:\/\/([^\/:]+)/ || die "URL: $url is not valid\n";
  if (not defined $host) { $host = $2; }
  if (findproxy($js_context, $url, $host)){
    print $js_context->property_get("pac.proxy")."\n";
  } else {
    print "Could not find proxy for url: $url";
  }
}

# Batch processing mode
if (defined $urls_list) {
  open(FILE, $urls_list);
  my @urllist = <FILE>;
  foreach (@urllist) {
    chomp;
    my $url = $_;
    # Extract host from URL
    if (not $url =~ /.*\:\/\/([^\/:]+).*/) {
      print "URL: '$url' is not valid\n";
      next;
    }
    my $host = $1;
    if (findproxy($js_context, $url, $host)){
      print $url."|".$js_context->property_get("pac.proxy")."\n";
    } else {
      print "Could not find proxy for url: $url";
    }
  }
}
